home *** CD-ROM | disk | FTP | other *** search
/ Aminet 35 / Aminet 35 (2000)(Schatztruhe)[!][Feb 2000].iso / Aminet / dev / basic / ImageDTInfo.lha / ImageDTInfo.bas < prev    next >
Encoding:
BASIC Source File  |  1999-11-30  |  6.2 KB  |  175 lines
  1. REM =========================================================================
  2. REM         ImageDTInfo [<image_filename>/<nombre_fichero_imagen>|?]
  3. REM
  4. REM   Created for use with  FWCalendar Arexx script written by Ron Goertz
  5. REM       and as a little coding exercise with (Hisoft|Maxon) Basic 2.
  6. REM            You can re-use freely this code in your own works.
  7. REM
  8. REM      Creado para usar con el guión ARexx FWCalendar de Ron Goertz
  9. REM  y como un pequeño ejercicio de programación con (Hisoft|Maxon) Basic 2.
  10. REM       Puede reutilizar libremente es código en sus producciones.
  11. REM              AmiSpaTra - http://www.arrakis.es/~amidde/
  12. REM =========================================================================
  13.  
  14. REM $NOWINDOW
  15.  
  16. ' ******** Constants, structs (sizes and offsets) and "prototypes" **********
  17. ' *** Constantes, estructuras (tamaños y desplazamientos) y "prototipos" ****
  18.  
  19. REM $include utility.bc
  20. REM $include intuition.bc
  21. REM $include datatypes/datatypesclass.bc
  22. REM $include datatypes/pictureclass.bc
  23.  
  24. REM $include dos.bh
  25. REM $include datatypes.bh
  26.  
  27. ' *************** Opening libraries / Apertura de bibliotecas **************
  28.  
  29. ' IoErr()
  30. ' -------
  31. LIBRARY OPEN "dos.library"
  32.  
  33. ' NewDTObjectA(), GetDTAttribsA(), DisposeDTObject()
  34. ' --------------------------------------------------
  35. LIBRARY OPEN "datatypes.library"
  36.  
  37. ' ******** Variables initialization / Inicialización de variables ***********
  38.  
  39. ' Copyright string / Cadena de autoría
  40. ' ------------------------------------
  41. version$ ="$VER: ImageDTInfo 1.1 (29.11.99) by © Dámaso D. Estévez <amidde@arrakis.es>"
  42.  
  43. ' Pointer to structs / Puntero a estructura: `Object'
  44. ' ---------------------------------------------------
  45. o& = NULL&
  46.  
  47. ' Pointer to structs / Puntero a estructura: `BitMapHeader'
  48. ' ---------------------------------------------------------
  49. b& = NULL&
  50.  
  51. ' Pointers to structs / Puntero a estructura: `DataType'
  52. ' ------------------------------------------------------
  53. d& = NULL&
  54.  
  55. ' Array for taglist's work.
  56. ' Matriz para trabajar con listas de atributos-propiedades.
  57. ' ---------------------------------------------------------
  58. DIM tags&(4)
  59.  
  60. ' For contain the IO error / Para memorizar el código de error E/S
  61. ' ----------------------------------------------------------------
  62. retval& = NULL&
  63.  
  64. ' ************************ Main code / Código principal *********************
  65.  
  66. IF COMMAND$ <> "" AND COMMAND$ <> "?" THEN
  67.  
  68.     ' Tags array for `NewDTObjectA()' (only image picture files).
  69.     ' Lista de atributos para `NewDTObjectA()' (sólo ficheros gráficos).
  70.     '  -----------------------------------------------------------------
  71.     TAGLIST VARPTR(tags&(0)),_
  72.         DTA_SourceType&,DTST_FILE&,_
  73.         DTA_GroupID&,GID_PICTURE&,_
  74.         TAG_DONE&
  75.  
  76.     ' To set pointers to empty structures (`Datatype' & `BitMapHeader').
  77.     ' Definir punteros a estructuras vacias (`Datatype' & `BitMapHeader').
  78.     ' --------------------------------------------------------------------
  79.     d&=SADD(STRING$(Datatype_sizeof%,CHR$(0)))
  80.     b&=SADD(STRING$(BitMapHeader_sizeof%,CHR$(0)))
  81.  
  82.     ' If I obtain theses "structs"... / Si consigo crear esas "estructuras"...
  83.     ' ------------------------------------------------------------------------
  84.     IF d& <> NULL& AND b& <> NULL& THEN
  85.  
  86.         ' ... I ask my object (the graphic file) for work with this.
  87.         ' ... solicito mi objeto (el fichero gráfico) para trabajar con él.
  88.         ' -----------------------------------------------------------------
  89.         o& = NewDTObjectA&(SADD(COMMAND$+CHR$(0)),VARPTR(tags&(0)))
  90.  
  91.         ' If the answer is positive... / Si la respuesta es positiva...
  92.         ' -------------------------------------------------------------
  93.         IF o& <> NULL& THEN
  94.  
  95.  
  96.             ' I need the height, widht, planes and image type info.
  97.             ' Necesito la altura, anchura, planos y tipo de imagen.
  98.             ' -----------------------------------------------------
  99.             TAGLIST VARPTR(tags&(0)),_
  100.                 PDTA_BitMapHeader&,VARPTR(b&),_
  101.                 DTA_Datatype&, VARPTR(d&),_
  102.                 TAG_DONE&
  103.  
  104.             ' I ask the info needed and if this works (the answer is the the attrib asked number)...
  105.             ' Solicito la información que necesito y si se nos devuelve el nº de atributos pedidos...
  106.             ' ---------------------------------------------------------------------------------------
  107.             IF (GetDTAttrsA&(o&,VARPTR(tags&(0)))) = 2 THEN
  108.  
  109.                 ' ... prints the info / ... imprimo la información
  110.                 ' The subclass type has four chars / El tipo de subclase ocupa cuatro caracteres
  111.                 ' ------------------------------------------------------------------------------
  112.                 PRINT UCASE$(CHR$(PEEK(PEEKL(d&+dtn_Header%)+dth_ID%+0%)));
  113.                 PRINT UCASE$(CHR$(PEEK(PEEKL(d&+dtn_Header%)+dth_ID%+1%)));
  114.                 PRINT UCASE$(CHR$(PEEK(PEEKL(d&+dtn_Header%)+dth_ID%+2%)));
  115.                 PRINT UCASE$(CHR$(PEEK(PEEKL(d&+dtn_Header%)+dth_ID%+3%)));
  116.                 PRINT " -";
  117.                 PRINT PEEKW(b&+bmh_Width%);
  118.                 PRINT "x";
  119.                 PRINT PEEKW(b&+bmh_Height%);
  120.                 PRINT "x";
  121.                 PRINT PEEK(b&+bmh_Depth%)
  122.  
  123.             ELSE
  124.  
  125.                 ' Assign the IoErr&() result inmediatly or you will lost this.
  126.                 ' Asigne el resultado de IoErr&() inmediatamente a una variable o lo perderá.
  127.                 ' ---------------------------------------------------------------------------
  128.                 retval& = IoErr&()
  129.  
  130.             END IF
  131.  
  132.             ' I've finnished with the object... I release this.
  133.             ' Hemos terminado con el objeto... así que lo liberamos.
  134.             ' ------------------------------------------------------
  135.             DisposeDTObject&(o&)
  136.  
  137.         ELSE
  138.  
  139.             retval& = IoErr&()
  140.  
  141.         END IF
  142.  
  143.     ELSE
  144.  
  145.         PRINT "* ERROR * - BitMapHeader/DataType"
  146.         PRINT "No memory for structs - Memoria insuficiente para las estructuras"
  147.  
  148.     END IF
  149.  
  150. ELSE
  151.  
  152.     ' The user asks info or don't include a filename as argument.
  153.     ' El usuario pide información o no incluye un nombre de fichero como argumento.
  154.     ' -----------------------------------------------------------------------------
  155.     PRINT
  156.     PRINT RIGHT$(version$,LEN(version$)-6)
  157.     PRINT
  158.     PRINT "This program needs as argument ONLY a graphic filename."
  159.     PRINT "Este programa necesita como argumento SÓLO el nombre de un fichero gráfico."
  160.     PRINT
  161.  
  162. END IF
  163.  
  164. ' If there was some I/O related error, prints the error code and the CLI parameter.
  165. ' Si se ha producido algún error E/S, imprime el código de error y el argumento CLI.
  166. ' ----------------------------------------------------------------------------------
  167. IF retval& <> 0 THEN
  168.  
  169.     PRINT "* ERROR * - IoErr&()"
  170.     PRINT "Code/código: ";retval&;" - Argument/argumento: `";COMMAND$;"'"
  171.  
  172. END IF
  173.  
  174. END
  175.